home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / 3d / 3d.bas next >
Encoding:
BASIC Source File  |  1995-05-09  |  11.4 KB  |  281 lines
  1. ' 3D Routines - By Daniel Benito [TeleSoft]
  2.  
  3. ' This is a minute collection of very simple routines that enable
  4. ' you to paint several kinds of frames around controls and forms,
  5. ' adding a 3D effect to your application.
  6.  
  7. ' They were written to cover a basic need, while keeping code
  8. ' simple and fast.
  9.  
  10. ' These subroutines are loosely based on a routine called Outlines,
  11. ' which is included in the VB 3.0 sample application VISDATA.
  12.  
  13. ' If you have any questions, send me a message to the CIS address
  14. ' 100022,141, or post it in the MSBASIC forum.
  15.  
  16. Sub InLinePic (pic_name As Control, bevel_size As Integer)
  17.     
  18. ' This subroutine paints a raised frame on the border of a form,
  19. ' giving it a 3D effect.
  20. '
  21. ' Parameters:
  22. ' pic_name   - Picture on which to paint frame
  23. ' bevel_size - Bevel width
  24.  
  25.  
  26.     Dim darkgray As Long, brwhite As Long
  27.     Dim i As Integer, x As Integer, y As Integer, x1 As Integer, y1 As Integer
  28.     Dim col1 As Long, col2 As Long
  29.     Dim pic_top As Integer, pic_left As Integer, pic_right As Integer, pic_bottom As Integer
  30.     darkgray = RGB(128, 128, 128)
  31.     brwhite = RGB(255, 255, 255)
  32.     pic_top = pic_name.ScaleTop
  33.     pic_left = pic_name.ScaleLeft
  34.     pic_bottom = pic_name.ScaleHeight - screen.TwipsPerPixelY 'bottom minus one pixel
  35.     pic_right = pic_name.ScaleWidth - screen.TwipsPerPixelX 'right minus one pixel
  36.     bevel_size = bevel_size - 1
  37.     x1 = screen.TwipsPerPixelX 'twips per pixel horizontally
  38.     y1 = screen.TwipsPerPixelY 'twips per pixel vertically
  39.  
  40.     For i = -1 To bevel_size
  41.         x = x1 * i 'distance of horiz. lines from edge
  42.         y = y1 * i 'distance of vert. lines from edge
  43.         pic_name.Line (pic_left + x, pic_bottom - y)-(pic_right - x, pic_bottom - y), darkgray
  44.         pic_name.Line (pic_right - x, pic_top + y)-(pic_right - x, pic_bottom - y), darkgray
  45.         pic_name.Line (pic_left + x, pic_top + y)-(pic_right - x, pic_top + y), brwhite
  46.         pic_name.Line (pic_left + x, pic_top + y)-(pic_left + x, pic_bottom - y), brwhite
  47.     Next i
  48. End Sub
  49.  
  50. Sub OutlineControl (form_name As Form, ctrl_name As Control, bevel_size As Integer, dn As Integer)
  51.   
  52. ' This subroutine paints a frame around a control, giving it a 3D effect.
  53. ' Parameters:
  54. ' form_name  - Form on which control is
  55. ' ctrl_name  - Control on which to paint frame
  56. ' bevel_size - Bevel width
  57. ' dn         - If TRUE, box is drawn sunken. If FALSE, box is drawn raised
  58.  
  59.     Dim darkgray As Long, brwhite As Long
  60.     Dim i As Integer, x As Integer, y As Integer, x1 As Integer, y1 As Integer
  61.     Dim col1 As Long, col2 As Long
  62.     Dim ctrl_top As Integer, ctrl_left As Integer, ctrl_right As Integer, ctrl_bottom As Integer
  63.     darkgray = RGB(128, 128, 128)
  64.     brwhite = RGB(255, 255, 255)
  65.  
  66.     Select Case dn
  67.         Case True
  68.             col1 = brwhite
  69.             col2 = darkgray
  70.         Case False
  71.             col2 = brwhite
  72.             col1 = darkgray
  73.         Case Else
  74.             Exit Sub
  75.     End Select
  76.  
  77.     x1 = screen.TwipsPerPixelX 'twips per pixel horizontally
  78.     y1 = screen.TwipsPerPixelY 'twips per pixel vertically
  79.     bevel_size = bevel_size - 1
  80.  
  81.     For i = 0 To bevel_size Step 1
  82.         x = x1 * i 'distance of horiz. lines from edge
  83.         y = y1 * i 'distance of vert. lines from edge
  84.         ctrl_top = ctrl_name.Top - screen.TwipsPerPixelY
  85.         ctrl_left = ctrl_name.Left - screen.TwipsPerPixelX
  86.         ctrl_right = ctrl_name.Left + ctrl_name.Width
  87.         ctrl_bottom = ctrl_name.Top + ctrl_name.Height
  88.         form_name.Line (ctrl_left - x, ctrl_bottom + y)-(ctrl_right + x, ctrl_bottom + y), col1
  89.         form_name.Line (ctrl_right + x, ctrl_top - y)-(ctrl_right + x, ctrl_bottom + y), col1
  90.         form_name.Line (ctrl_left - x, ctrl_top - y)-(ctrl_right + x, ctrl_top - y), col2
  91.         form_name.Line (ctrl_left - x, ctrl_top - y)-(ctrl_left - x, ctrl_bottom + y), col2
  92.     Next i
  93. End Sub
  94.  
  95. Sub OutlineControlPic (pic_name As Control, ctrl_name As Control, bevel_size As Integer, dn As Integer)
  96.     
  97. ' This subroutine paints a frame around a control inside a picture box,
  98. ' giving it a 3D effect.
  99. '
  100. ' Parameters:
  101. ' pic_name   - Picture box which contains control
  102. ' ctrl_name  - Control on which to paint frame
  103. ' bevel_size - Bevel width
  104. ' dn         - If TRUE, box is drawn sunken. If FALSE, box is drawn raised
  105.  
  106.     
  107.     Dim darkgray As Long, brwhite As Long
  108.     Dim i As Integer, x As Integer, y As Integer, x1 As Integer, y1 As Integer
  109.     Dim col1 As Long, col2 As Long
  110.     Dim ctrl_top As Integer, ctrl_left As Integer, ctrl_right As Integer, ctrl_bottom As Integer
  111.  
  112.     darkgray = RGB(128, 128, 128)
  113.     brwhite = RGB(255, 255, 255)
  114.  
  115.     Select Case dn
  116.         Case True
  117.             col1 = brwhite
  118.             col2 = darkgray
  119.         Case False
  120.             col2 = brwhite
  121.             col1 = darkgray
  122.         Case Else
  123.             Exit Sub
  124.     End Select
  125.  
  126.     x1 = screen.TwipsPerPixelX 'twips per pixel horizontally
  127.     y1 = screen.TwipsPerPixelY 'twips per pixel vertically
  128.     bevel_size = bevel_size - 1
  129.  
  130.     For i = 0 To bevel_size Step 1
  131.         x = x1 * i 'distance of horiz. lines from edge
  132.         y = y1 * i 'distance of vert. lines from edge
  133.         ctrl_top = ctrl_name.Top - screen.TwipsPerPixelY
  134.         ctrl_left = ctrl_name.Left - screen.TwipsPerPixelX
  135.         ctrl_right = ctrl_name.Left + ctrl_name.Width
  136.         ctrl_bottom = ctrl_name.Top + ctrl_name.Height
  137.         pic_name.Line (ctrl_left - x, ctrl_bottom + y)-(ctrl_right + x, ctrl_bottom + y), col1
  138.         pic_name.Line (ctrl_right + x, ctrl_top - y)-(ctrl_right + x, ctrl_bottom + y), col1
  139.         pic_name.Line (ctrl_left - x, ctrl_top - y)-(ctrl_right + x, ctrl_top - y), col2
  140.         pic_name.Line (ctrl_left - x, ctrl_top - y)-(ctrl_left - x, ctrl_bottom + y), col2
  141.     Next i
  142. End Sub
  143.  
  144. Sub OutlineForm (form_name As Form, bevel_size As Integer)
  145.     
  146. ' This subroutine paints a raised frame on the border of a form around a control,
  147. ' giving it a 3D effect.
  148. '
  149. ' Parameters:
  150. ' form_name  - Form on which to paint frame
  151. ' bevel_size - Bevel width
  152.  
  153.  
  154.     Dim darkgray As Long, brwhite As Long
  155.     Dim i As Integer, x As Integer, y As Integer, x1 As Integer, y1 As Integer
  156.     Dim col1 As Long, col2 As Long
  157.     Dim form_top As Integer, form_left As Integer, form_right As Integer, form_bottom As Integer
  158.     darkgray = RGB(128, 128, 128)
  159.     brwhite = RGB(255, 255, 255)
  160.     form_top = form_name.ScaleTop
  161.     form_left = form_name.ScaleLeft
  162.     form_bottom = form_name.ScaleHeight - screen.TwipsPerPixelY 'bottom minus one pixel
  163.     form_right = form_name.ScaleWidth - screen.TwipsPerPixelX 'right minus one pixel
  164.     bevel_size = bevel_size - 1
  165.     x1 = screen.TwipsPerPixelX 'twips per pixel horizontally
  166.     y1 = screen.TwipsPerPixelY 'twips per pixel vertically
  167.  
  168.     For i = -1 To bevel_size
  169.         x = x1 * i 'distance of horiz. lines from edge
  170.         y = y1 * i 'distance of vert. lines from edge
  171.         form_name.Line (form_left + x, form_bottom - y)-(form_right - x, form_bottom - y), darkgray
  172.         form_name.Line (form_right - x, form_top + y)-(form_right - x, form_bottom - y), darkgray
  173.         form_name.Line (form_left + x, form_top + y)-(form_right - x, form_top + y), brwhite
  174.         form_name.Line (form_left + x, form_top + y)-(form_left + x, form_bottom - y), brwhite
  175.     Next i
  176.  
  177. End Sub
  178.  
  179. Sub OutlinePic (form_name As Form, ctrl_name As Control, dn As Integer)
  180.     
  181. ' This subroutine paints a 3D box, with a 1 pixel bevel, around a control.
  182. ' Parameters:
  183. ' form_name  - Form on which control is
  184. ' ctrl_name  - Control on which to paint frame
  185. ' dn         - If TRUE, box is drawn sunken. If FALSE, box is drawn raised
  186.     
  187.     Dim darkgray As Long, brwhite As Long
  188.     Dim i As Integer
  189.     Dim col1 As Long, col2 As Long
  190.     Dim ctrl_top As Integer, ctrl_left As Integer, ctrl_right As Integer, ctrl_bottom As Integer
  191.  
  192.     darkgray = RGB(128, 128, 128)
  193.     brwhite = RGB(255, 255, 255)
  194.  
  195.     Select Case dn
  196.         Case True
  197.             col1 = brwhite
  198.             col2 = darkgray
  199.         Case False
  200.             col2 = brwhite
  201.             col1 = darkgray
  202.         Case Else
  203.             Exit Sub
  204.     End Select
  205.  
  206.     x = screen.TwipsPerPixelX 'twips per pixel horizontally
  207.     y = screen.TwipsPerPixelY 'twips per pixel vertically
  208.     
  209.  
  210.         x2 = x * 2
  211.         y2 = y * 2
  212.         'First box
  213.         ctrl_top = ctrl_name.Top - screen.TwipsPerPixelY
  214.         ctrl_left = ctrl_name.Left - screen.TwipsPerPixelX
  215.         ctrl_right = ctrl_name.Left + ctrl_name.Width
  216.         ctrl_bottom = ctrl_name.Top + ctrl_name.Height
  217.         form_name.Line (ctrl_left - x, ctrl_bottom + y2)-(ctrl_right + x2, ctrl_bottom + y2), col1
  218.         form_name.Line (ctrl_right + x2, ctrl_top - y)-(ctrl_right + x2, ctrl_bottom + y2), col1
  219.         form_name.Line (ctrl_left - x, ctrl_top - y)-(ctrl_right + x2, ctrl_top - y), col1
  220.         form_name.Line (ctrl_left - x, ctrl_top - y)-(ctrl_left - x, ctrl_bottom + y2), col1
  221.         
  222.         'Second box
  223.         ctrl_top = ctrl_name.Top - screen.TwipsPerPixelY
  224.         ctrl_left = ctrl_name.Left - screen.TwipsPerPixelX
  225.         ctrl_right = ctrl_name.Left + ctrl_name.Width
  226.         ctrl_bottom = ctrl_name.Top + ctrl_name.Height
  227.         form_name.Line (ctrl_left - x2, ctrl_bottom + y)-(ctrl_right + x, ctrl_bottom + y), col2
  228.         form_name.Line (ctrl_right + x, ctrl_top - y2)-(ctrl_right + x, ctrl_bottom + y), col2
  229.         form_name.Line (ctrl_left - x2, ctrl_top - y2)-(ctrl_right + x, ctrl_top - y2), col2
  230.         form_name.Line (ctrl_left - x2, ctrl_top - y2)-(ctrl_left - x2, ctrl_bottom + y), col2
  231.     
  232.  
  233. End Sub
  234.  
  235. Sub RemoveOutlineControl (form_name As Form, ctrl_name As Control, bevel_size As Integer, dn As Integer)
  236.   
  237. ' This subroutine UNpaints a frame around a control, REMOVING its 3D effect.
  238. ' Parameters:
  239. ' form_name  - Form on which control is
  240. ' ctrl_name  - Control on which to paint frame
  241. ' bevel_size - Bevel width
  242. ' dn         - If TRUE, box is drawn sunken. If FALSE, box is drawn raised
  243.  
  244.     Dim darkgray As Long, brwhite As Long
  245.     Dim i As Integer, x As Integer, y As Integer, x1 As Integer, y1 As Integer
  246.     Dim col1 As Long, col2 As Long
  247.     Dim ctrl_top As Integer, ctrl_left As Integer, ctrl_right As Integer, ctrl_bottom As Integer
  248.     darkgray = RGB(64, 64, 64)
  249.     brwhite = RGB(64, 64, 64)
  250.  
  251.     Select Case dn
  252.         Case True
  253.             col1 = brwhite
  254.             col2 = darkgray
  255.         Case False
  256.             col2 = brwhite
  257.             col1 = darkgray
  258.         Case Else
  259.             Exit Sub
  260.     End Select
  261.  
  262.     x1 = screen.TwipsPerPixelX 'twips per pixel horizontally
  263.     y1 = screen.TwipsPerPixelY 'twips per pixel vertically
  264.     bevel_size = bevel_size - 1
  265.  
  266.     For i = 0 To bevel_size Step 1
  267.         x = x1 * i 'distance of horiz. lines from edge
  268.         y = y1 * i 'distance of vert. lines from edge
  269.         ctrl_top = ctrl_name.Top - screen.TwipsPerPixelY
  270.         ctrl_left = ctrl_name.Left - screen.TwipsPerPixelX
  271.         ctrl_right = ctrl_name.Left + ctrl_name.Width
  272.         ctrl_bottom = ctrl_name.Top + ctrl_name.Height
  273.         form_name.Line (ctrl_left - x, ctrl_bottom + y)-(ctrl_right + x, ctrl_bottom + y), col1
  274.         form_name.Line (ctrl_right + x, ctrl_top - y)-(ctrl_right + x, ctrl_bottom + y), col1
  275.         form_name.Line (ctrl_left - x, ctrl_top - y)-(ctrl_right + x, ctrl_top - y), col2
  276.         form_name.Line (ctrl_left - x, ctrl_top - y)-(ctrl_left - x, ctrl_bottom + y), col2
  277.     Next i
  278.  
  279. End Sub
  280.  
  281.